ADA Programming Guide

home *** CD-ROM | disk | FTP | other *** search

/ ADA Programming Guide / ADA Programming Guide.iso / ada_tut / ada_tutr.ada < prev next >

Wrap

Text File | 1996-01-30 | 26KB | 520 lines

-- ADA_TUTR.ADA Ver. 3.00 22-AUG-1994 Copyright 1988-1994 John J. Herro -- Software Innovations Technology -- 1083 Mandarin Drive NE, Palm Bay, FL 32905-4706 (407)951-0233 -- -- Before compiling this file, you must compile ONE of the following: -- -- JANUS16.PKG Recommended when using a PC with 16-bit Janus/Ada. -- JANUS32.PKG Recommended when using a PC with 32-bit Janus/Ada. -- MERIDIAN.ADA Recommended when using a PC with a Meridian Ada compiler. -- UNIX.ADA Recommended for UNIX based systems, if you can also -- compile ONECHAR.C or ALTCHAR.C with a C compiler and -- link with Ada. -- VAX.ADA Recommended when using VAX Ada. -- VANILLA.ADA "Plain vanilla" version for all other systems. Should work -- with ANY standard Ada compiler. On some systems, -- VANILLA.ADA may require you to strike ENTER after each -- response. However, you don't have to strike ENTER with -- recent versions of TeleGen Ada by Telesoft. -- -- See the PRINT.ME file for more information on installing ADA-TUTR on other -- computers. -- -- -- Before Running ADA-TUTR on a PC: -- -- ADA-TUTR uses ANSI escape sequences for highlighting, cursor positioning, -- reverse video, etc. Before ADA-TUTR will work correctly on a PC, you must -- install the device driver ANSI.SYS, which came with your copy of DOS. To -- install ANSI.SYS, do the following: -- -- 1. If there's a file CONFIG.SYS in the root directory of the disk from -- which you boot, type it and look for a line saying "DEVICE=ANSI.SYS" -- (without the quotes), in either upper or lower case. If that line isn't -- present, add it to CONFIG.SYS anywhere in the file, using an ordinary -- text editor or word processor in the non-document mode. If there's no -- CONFIG.SYS file, create one containing the single line "DEVICE=ANSI.SYS" -- (without the quotes). -- -- 2. If there's no file ANSI.SYS in your root directory, copy ANSI.SYS from -- your DOS distribution diskette to the root directory of the disk from -- which you boot. -- -- 3. Reboot the computer. ADA-TUTR should then work correctly. -- -- Introduction: -- -- ADA-TUTR provides interactive instruction in the Ada programming language, -- allowing you to learn at your own pace. On a PC, access to an Ada compiler -- is helpful, but not required. You can exit this program at any time by -- striking X, and later resume the session exactly where you left off. If you -- have a color monitor, you can set the foreground, background, and border -- colors at any time by typing S. -- -- ADA-TUTR presents a screenful of information at a time. Screens are read -- in 64-byte blocks from the random access file ADA_TUTR.DAT, using Direct_IO. -- For most screens, ADA-TUTR waits for you to strike one character to -- determine which screen to show next. Screens are numbered starting with -- 101; each screen has a three-digit number. Screens 101 through 108 have -- special uses, as follows: -- -- 101 - This screen is presented when you complete the Ada course. It -- contains a congratulatory message. After this screen is shown, -- control returns directly to the operating system; the program doesn't -- wait for you to strike a character. -- 102 - This screen is presented when you exit ADA-TUTR before completing the -- course. After this screen is shown, control returns directly to the -- operating system; the program doesn't wait for you to strike a -- character. -- 103 - This screen is shown whenever you strike X. It displays the number of -- the last screen shown and the approximate percentage through the -- course. It then asks if you want to exit the program. If you strike -- Y, screen 102 is shown and control returns to the operating system. -- If you type N, screen 108 is shown to provide a menu of further -- choices. From screen 103, you can also strike M to see the main menu -- (screen 106). -- 104 - This is the opening screen. It asks if you've used ADA-TUTR before. -- If you strike N, a welcome screen is presented and the course begins. -- If you strike Y, screen 107 is shown. -- 105 - This screen allows you to type the number of the next screen you want -- to see. For this screen, instead of striking one character, you type -- a three-digit number and presses ENTER. Any number from 104 through -- the largest screen number is accepted. -- 106 - This screen contains the main menu of topics covered in ADA-TUTR. -- When you select a main topic, an appropriate sub-menu is shown. -- 107 - This screen is shown when you say that you've used ADA-TUTR before. -- It says "Welcome back!" and provides a menu that lets you resume where -- you left off, go back to the last question or Outside Assignment, go -- to the main menu (screen 106), or go to any specified screen number -- (via screen 105). -- 108 - This screen is shown when you answer N to screen 103. It provides a -- menu similar to screen 107, except that the first choice takes you -- back to the screen shown before you saw 103. For example, if you -- strike X while viewing screen 300, you'll see screen 103. If you then -- answer N, you'll see screen 108. From 108 the first menu selection -- takes you back to 300. -- -- Format of the Data File: -- -- ADA-TUTR.DAT is a random access file of 64-byte blocks. The format of this -- file changed considerably with version 2.00 of ADA-TUTR. It's now much more -- compact, and, although it's still a data file, it now contains only the 95 -- printable ASCII characters. -- -- The first block of ADA_TUTR.DAT is referred to as block 1, and the first 35 -- blocks together are called the index. Bytes 2 through 4 of block 1 contain, -- in ASCII, the number of the welcome screen that's shown when you say that -- you haven't used ADA-TUTR before. Bytes 6 through 8 of block 1 contain the -- number of the highest screen in the course. (Bytes 1 and 5 of block 1 -- contain spaces.) -- -- Bytes 9 of block 1 through the end of block 31 contain four bytes of -- information for each of the possible screens 101 through 658. For example, -- information for screen 101 is stored in bytes 9 through 12 of block 1, the -- next four bytes are for screen 102, etc. For screens that don't exist, all -- four bytes contain spaces. -- -- The first of the four bytes is A if the corresponding screen introduces an -- Outside Assignment, Q if the screen asks a question, or a space otherwise. -- The next two bytes give the number of the block where data for the screen -- begins, in base 95! A space represents 0, ! represents 1, " represents 2, -- # represents 3, $ represents 4, etc., through all the printable characters -- of the ASCII set. A tilde (~) represents 94. -- -- The last of the four bytes gives the position, 1 through 64, within the -- block where the data for this screen starts. Again, ! represents 1, -- " represents 2, # represents 3, etc. -- -- Data for the screens are stored starting in position 1 of block 36. In the -- screen data, the following characters have special meaning: -- -- % turns on high intensity. -- @ displays the number of spaces indicated by the next -- character (# represents 3, $ represents 4, etc.) -- \ turns on reverse video and leaves one space. -- ^ turns on high intensity and leaves one space. -- ` restores normal video. -- { causes CR-LF. -- } moves cursor to row 24, column 1, for a prompt. -- ~ restores normal video and leaves one space. -- -- These characters have special meaning in screen 103 only: -- -- # shows approximate percentage through the course. -- $ shows the number of the screen seen before 103. -- -- Immediately after }, b represents "Please type a space to go on, or B to go -- back." and q represents "Please type a space to go on, or B or Q to go back -- to the question." -- -- -- The data for each screen is followed by the "control information" for that -- screen, in square brackets. The control information is a list of characters -- that you might strike after seeing this screen. Each character is followed -- by the three-digit number of the next screen to be shown when that character -- is struck. For example, Y107N122 is the control information for screen 104. -- This means that if you strike Y, screen 107 will be shown next, and if you -- strikes N, screen 122 will be shown. Striking any other character will -- simply cause a beep (except that X can always be typed to exit the program, -- S can always be typed to set colors, and CR will be ignored). If the -- control information is simply #, you are prompted to type the next screen -- number. This feature is used in screen 105. -- -- A "screen number" of 098 following a character means "go back to the last -- Outside Assignment," and 099 means "go back to the last question." These -- special numbers are used in screens 107 and 108. Number 100 means "go back -- to the previous screen seen." -- -- ADA-TUTR opens the Data File in In_File mode for read-only access. -- -- -- -- Format of the User File: -- -- The User File ADA_TUTR.USR initially doesn't exist. It's created the first -- time ADA-TUTR is run. -- -- ADA_TUTR.USR is a random access file containing one 64-byte block. Bytes 2 -- through 4 contain, in ASCII, the number of the last screen read the last -- time you ran ADA-TUTR. Byte 6 contains a digit for the foreground color you -- select, byte 8 contains a digit for the background color, and byte 10 -- contains a digit for the border color. All other bytes contain spaces. The -- ASCII characters '0' through '7' represent black, red, green, yellow, blue, -- magenta, cyan, and white, in that order. Note that not all color PCs have a -- separate border color. ADA_TUTR.USR is a random access file so that it can -- be easily updated by Ada. It contains 64 bytes so that it can be accessed -- with the same package, namely Random_IO, that accesses the Data File. -- -- If the User File exists, ADA-TUTR opens it in Inout_File mode for read/write -- access. If it doesn't exist, ADA-TUTR creates it. -- with Custom_IO, Direct_IO; use Custom_IO; procedure Ada_Tutr is subtype Block_Subtype is String(1 .. 64); package Random_IO is new Direct_IO(Block_Subtype); use Random_IO; IxSize : constant := 35; -- Number of blocks in the index. Data_File : File_Type; -- The file from which screens are read. User_File : File_Type; -- Remembers last screen seen, and colors. Block : Block_Subtype; -- Buffer for random-access I/O. Vpos : Integer; -- Number of the current block. Hpos : Integer; -- Current position within current block. SN, Old_SN : Integer := 104; -- Screen num. and previous screen num. Quitting_SN : Integer := 104; -- Screen number where you left off. Highest_SN : Integer; -- Highest screen number in the course. Welcome_SN : Integer; -- Number of the screen shown to new users. Indx : String(1 .. 64*IxSize); -- Index from the Data File. Files_OK : Boolean := False; -- True when files open successfully. Legal_Note : constant String := " Copyright 1988-94 John J. Herro "; -- Legal_Note isn't used by the program, but it causes -- most compilers to place this string in the .EXE file. procedure Open_Data_File is separate; procedure Open_User_File is separate; procedure Show_Current_Screen is separate; procedure Get_Next_Screen_Number is separate; begin Open_Data_File; Open_User_File; if Files_OK then Set_Border_Color(To => Border_Color); -- Set default colors. Put(Normal_Colors); while SN > 0 loop -- "Screen number" of 0 means end the program. Put(Clear_Scrn); -- Clear the screen. Show_Current_Screen; Get_Next_Screen_Number; end loop; Block := (others => ' '); -- Write user-specific data to user file. Block(1 .. 4) := Integer'Image(Quitting_SN); Block(6) := Fore_Color_Digit; Block(8) := Back_Color_Digit; Block(10) := Character'Val(Color'Pos(Border_Color) + 48); Write(User_File, Item => Block, To => 1); Close(Data_File); Close(User_File); end if; end Ada_Tutr; separate (Ada_Tutr) procedure Open_Data_File is Data_File_Name : constant String := "ADA_TUTR.DAT"; begin Open(Data_File, Mode => In_File, Name => Data_File_Name); for I in 1 .. IxSize loop -- Read index from start of Data File. Read(Data_File, Item => Block, From => Count(I)); Indx(64*I - 63 .. 64*I) := Block; end loop; Welcome_SN := Integer'Value(Indx(2 .. 4)); Highest_SN := Integer'Value(Indx(6 .. 8)); Files_OK := True; exception when Name_Error => Put("I'm sorry. The file " & DATA_FILE_NAME); Put_Line(" seems to be missing."); when others => Put("I'm sorry. The file " & DATA_FILE_NAME); Put_Line(" seems to have the wrong form."); end Open_Data_File; separate (Ada_Tutr) procedure Open_User_File is User_File_Name : constant String := "ADA_TUTR.USR"; begin Open(User_File, Mode => Inout_File, Name => User_File_Name); Read(User_File, Item => Block, From => 1); Quitting_SN := Integer'Value(Block(1 .. 4)); Old_SN := Quitting_SN; Foregrnd_Color := Color'Val(Integer'Value(Block(5 .. 6))); Backgrnd_Color := Color'Val(Integer'Value(Block(7 .. 8))); Border_Color := Color'Val(Integer'Value(Block(9 .. 10))); Fore_Color_Digit := Block(6); Back_Color_Digit := Block(8); Normal_Colors(6) := Fore_Color_Digit; Normal_Colors(9) := Back_Color_Digit; exception when Name_Error => begin Create(User_File, Mode => Inout_File, Name => User_File_Name); exception when others => Put("I'm sorry. I couldn't find or create "); Put_Line(User_File_Name); Files_OK := False; end; when others => Put_Line("I'm sorry. The file " & USER_FILE_NAME & " seems to have"); Put_Line("the wrong form or contain bad data."); Put_Line("You might want to delete the file and try again."); Put_Line("(Default values will be used.)"); Files_OK := False; end Open_User_File; separate (Ada_Tutr) procedure Show_Current_Screen is Half_Diff : Integer := (Highest_SN - Welcome_SN) / 2; Percent : Integer := (50 * (Old_SN - Welcome_SN)) / Half_Diff; -- Percentage of the course completed. Using 50 and -- Half_Diff guarantees that the numerator < 2 ** 15. Expanding : Boolean := False; -- True when expanding multiple spaces. Prompting : Boolean := False; -- True for first character in a prompt. Space : constant String(1 .. 80) := (others => ' '); procedure Process_Char is separate; begin Vpos := 95*(Character'Pos(Indx(SN*4 - 394)) - 32) + -- Point to start Character'Pos(Indx(SN*4 - 393)) - 32; -- of current Hpos := Character'Pos(Indx(SN*4 - 392)) - 32; -- screen. Read(Data_File, Item => Block, From => Count(Vpos)); if Percent < 0 then -- Make sure Percent is reasonable. Percent := 0; elsif Percent > 99 then Percent := 99; end if; while Block(Hpos) /= '[' or Expanding loop -- [ starts the control info. if Expanding then Put(Space(1 .. Character'Pos(Block(Hpos)) - 32)); Expanding := False; elsif Prompting then case Block(Hpos) is when 'b' => Put("Please type a space to go on, or B to go back."); when 'q' => Put("Please type a space to go on, or B or Q to go "); Put("back to the question."); when others => Process_Char; end case; Prompting := False; else Process_Char; end if; Hpos := Hpos + 1; if Hpos > Block'Length then Vpos := Vpos + 1; Hpos := 1; Read(Data_file, Item => Block, From => Count(Vpos)); end if; end loop; end Show_Current_Screen; separate (Ada_Tutr.Show_Current_Screen) procedure Process_Char is begin case Block(Hpos) is when '{' => New_Line; -- { = CR-LF. when '@' => Expanding := True; -- @ = several spaces. when '^' => Put(ASCII.ESC & "[1m "); -- ^ = bright + space. when '~' => Put(Normal_Colors & ' '); -- ~ = normal + space. when '%' => Put(ASCII.ESC & "[1m"); -- % = bright. when '`' => Put(Normal_Colors); -- ` = normal. when '}' => Put(ASCII.ESC & "[24;1H"); -- } = go to line 24. Prompting := True; when '\' => Put(ASCII.ESC & "[7m "); -- \ = rev. vid. + sp. when '$' => if SN = 103 then -- $ = screen #. Put(Integer'Image(Old_SN)); else Put('$'); end if; when '#' => if SN = 103 then -- # = % completed. Put(Integer'Image(Percent)); else Put('#'); end if; when others => Put(Block(Hpos)); end case; end Process_Char; separate (Ada_Tutr) procedure Get_Next_Screen_Number is Ctrl_Info : Block_Subtype; -- Control info. for the current screen. Place : Integer := 1; -- Current position within Ctrl_Info. Input : String(1 .. 4); -- Screen number that you type. Len : Integer; -- Length of typed response. Valid : Boolean; -- True when typed response is valid. procedure Set_Colors is separate; procedure Input_One_Keystroke is separate; begin while Block(Hpos) /= ']' loop -- Read control information from Data File. Hpos := Hpos + 1; if Hpos > Block'Length then Vpos := Vpos + 1; Hpos := 1; Read(Data_File, Item => Block, From => Count(Vpos)); end if; Ctrl_Info(Place) := Block(Hpos); Place := Place + 1; end loop; if SN = 103 then -- Screen 103 means you typed X to exit. Quitting_SN := Old_SN; elsif SN >= Welcome_SN then -- Save SN so you can return to it. Old_SN := SN; end if; if SN < 103 then -- Set SN to # of the next screen. SN := 0; -- Set signal to end the program after screens 101 and 102. elsif Ctrl_Info(1) = '#' then -- You type the next screen number. Valid := False; while not Valid loop -- Keep trying until response is valid. Put("# "); -- Prompt for screen number. Input := " "; Get_Line(Input, Len); -- Input screen number. if Input(1) = 'x' or Input(1) = 'X' or Input(1) = ASCII.ETX then SN := 103; -- Show screen 103 if you type X. Valid := True; -- X is a valid response. elsif Input(1) = 's' or Input(1) = 'S' then Set_Colors; -- Set colors if you type S. Valid := True; -- S is a valid response. else begin -- Convert ASCII input to SN := Integer'Value(Input); -- integer. If in range, Valid := SN in 104 .. Highest_SN; -- set Valid to True. If exception -- it can't be converted when others => null; -- (e.g., illegal char.), end; -- or it's out of range, end if; -- leave Valid = False so if not Valid and Len > 0 then -- you can try again. Put_Line("Incorrect number. Please try again."); end if; end loop; else Input_One_Keystroke; end if; end Get_Next_Screen_Number; separate (Ada_Tutr.Get_Next_Screen_Number) procedure Set_Colors is Bright : constant String := ASCII.ESC & "[1m"; -- Causes high intensity. Keystroke : Character := 'f'; -- Single character that you type. Space : constant String(1 .. 23) := (others => ' '); begin while Keystroke = 'f' or Keystroke = 'b' or Keystroke = 'r' or Keystroke = 'F' or Keystroke = 'B' or Keystroke = 'R' loop Put(Clear_Scrn); -- Clear the screen. New_Line; Put(Space & "The " & Bright & "foreground" & Normal_Colors); Put_Line(" color is now " & Color'Image(Foregrnd_Color) & '.'); Put(Space & "The " & Bright & "background" & Normal_Colors); Put_Line(" color is now " & Color'Image(Backgrnd_Color) & '.'); Put(Space & "The " & Bright & " border " & Normal_Colors); Put_Line(" color is now " & Color'Image(Border_Color) & '.'); New_Line; Put_Line(Space & " Note: Some color PCs don't have"); Put_Line(Space & " separate border colors."); New_Line; Put_Line(Space & " Strike:"); Put_Line(Space & "F to change the foreground color,"); Put_Line(Space & "B to change the background color,"); Put_Line(Space & "R to change the border color."); New_Line; Put_Line(Space & "Strike any other key to continue."); Get(Keystroke); -- Get one character from keyboard. if Keystroke = 'f' or Keystroke = 'F' then Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8); if Foregrnd_Color = Backgrnd_Color then Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8); end if; elsif Keystroke = 'b' or Keystroke = 'B' then Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8); if Foregrnd_Color = Backgrnd_Color then Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8); end if; elsif Keystroke = 'r' or Keystroke = 'R' then Border_Color := Color'Val((Color'Pos(Border_Color) + 1) mod 8); end if; Fore_Color_Digit := Character'Val(48 + Color'Pos(Foregrnd_Color)); Back_Color_Digit := Character'Val(48 + Color'Pos(Backgrnd_Color)); Normal_Colors(6) := Fore_Color_Digit; Normal_Colors(9) := Back_Color_Digit; Put(Normal_Colors); Set_Border_Color(To => Border_Color); end loop; end Set_Colors; separate (Ada_Tutr.Get_Next_Screen_Number) procedure Input_One_Keystroke is Keystroke : Character; -- Single character that you type. Valid : Boolean := False; -- True when typed response is valid. Where : Integer; -- Location of control block in Data File. Search : Character; -- 'A' = last Outside Assignment; 'Q' = last Ques. begin Put(" >"); -- Prompt for one character. while not Valid loop -- Keep trying until response is valid. Get(Keystroke); -- Get one character from keyboard. if Keystroke in 'a' .. 'z' then -- Force upper case to simplify. Keystroke := Character'Val(Character'Pos(Keystroke) - 32); end if; if Keystroke = 'X' or Keystroke = ASCII.ETX then SN := 103; -- Show screen 103 if you type X. Valid := True; -- X is a valid response. elsif Keystroke = 'S' then Set_Colors; -- Set colors if you type S. Valid := True; -- S is a valid response. end if; Place := 1; -- Search list of valid characters for this screen. Valid := Valid; -- This statement works around a minor bug in -- ver. 1.0 of the Meridian IFORM optimizer. while not Valid and Ctrl_Info(Place) /= ']' loop -- ] ends the list. if Keystroke = Ctrl_Info(Place) then -- Typed char. found in list; get screen # from control info. SN := Integer'Value(Ctrl_Info(Place + 1 .. Place + 3)); Valid := True; -- Characters in the list are all valid responses. end if; Place := Place + 4; -- A 3-digit number follows each char. in list. end loop; if not Valid and Keystroke /= ASCII.CR then -- Beep if response is Put(ASCII.BEL); -- not valid, but end if; -- ignore CRs quietly. end loop; if SN = 98 then -- Go back to last Outside Assignment. Search := 'A'; elsif SN = 99 then -- Go back to last question. Search := 'Q'; elsif SN = 100 then -- Go back to the last screen seen. SN := Quitting_SN; end if; if SN = 98 or SN = 99 then SN := Old_SN; while SN > Welcome_SN and Indx(SN*4 - 395) /= Search loop SN := SN - 1; end loop; end if; end Input_One_Keystroke;